home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / mntnc20.arc / STRIP10.PAS < prev   
Pascal/Delphi Source File  |  1986-01-05  |  4KB  |  151 lines
  1. PROGRAM Strip10;
  2.  
  3. {
  4.  
  5. Production Version 1.0
  6. (c) copyright 1985 J. Levine/ Atlantic Palisades
  7. Colossus Net 200/ Node 7  (718) 238-7855.  PUBLIC DOMAIN -- not for resale.
  8. This is a utility to remove lines from answers.bbs which have entries
  9. of less than 2 characters -- allows compact storage of old questionnaires.
  10.  
  11. }
  12.  
  13.  
  14.  
  15.  
  16. VAR
  17. Infile, Outfile : text;
  18. oneline: string[255];
  19. file1, file2 : string[14];
  20. lines, short_lines : integer;
  21. pct : real;
  22. OK : boolean;
  23. {--------------------------}
  24.  
  25. PROCEDURE linereader;  {read lines, strip out short lines}
  26. BEGIN
  27. clrscr;
  28. gotoxy(10,5);
  29. Writeln(file1, ' --> ',file2);
  30. WHILE NOT EOF(infile) DO
  31.       BEGIN
  32.       Readln(infile,oneline);
  33.       lines := lines+1;
  34.       IF Length(Oneline) > 4
  35.       THEN
  36.           BEGIN
  37.           Writeln(outfile,oneline);
  38.           Gotoxy(41,12);
  39.           ClrEOL;
  40.           gotoxy(41,10);
  41.           write('*');
  42.           gotoxy(10,10);
  43.           Write('Total Lines Copied = ',lines);
  44.  
  45.           END
  46.      ELSE
  47.          BEGIN
  48.          short_lines := short_lines+1;
  49.          Gotoxy(41,10);
  50.           ClrEOL;
  51.           gotoxy(41,12);
  52.           write('*');
  53.          gotoxy(10,12);
  54.          Write('Total Lines Eliminated = ', short_lines);
  55.          END;
  56.      IF short_lines >1
  57.      THEN
  58.          BEGIN
  59.          gotoxy(10,14);
  60.          Writeln('Total Lines Processed = ', lines+short_lines);
  61.          gotoxy(10,16);
  62.          pct := short_lines / (lines+short_lines);
  63.          Write('Savings =  ',pct*100:4:0,'%');
  64.          END;
  65.      END;
  66. END;
  67.  
  68. {-----------------------------}
  69.  
  70. PROCEDURE Initialize;
  71.  
  72. BEGIN
  73. clrscr;
  74. gotoxy(5,1);
  75. Writeln('Strip Utility for Colossus -- Public Domain -- Not for Resale');
  76. gotoxy(5,2);
  77. Writeln('                        Production Ver. 1.0');
  78. Gotoxy(5,3);
  79. Writeln('      (c) Copyright 1985 J. Levine/ Atlantic Palisades');
  80. Gotoxy(5,4);
  81. Writeln('           Colossus Net 200/ Node 7  (718) 238-7855');
  82.  
  83.  
  84. gotoxy(10,12);
  85. Write('What is the input file name? ');
  86.         REPEAT
  87.         Readln(file1);
  88.         Assign(Infile,File1);
  89.         {$I-} Reset(infile) {$I+};
  90.         OK := IOresult = 0;
  91.         IF NOT OK
  92.         THEN
  93.             BEGIN
  94.             gotoxy(10,12);
  95.             Write(^g,'Input file does not exist! Please reenter: ')
  96.             END
  97.         ELSE
  98.             BEGIN
  99.             gotoxy(10,15);
  100.             Write ('What is the output file name? ');
  101.                     REPEAT
  102.                     Readln(file2);
  103.                     IF file2 = file1
  104.                     THEN
  105.                         BEGIN
  106.                         ok := False;
  107.                         gotoxy(10,15);
  108.                         clreol;
  109.                         write(^g,' Same as Input File! Please reenter: ');
  110.                         END
  111.                     ELSE OK := TRUE;
  112.                     UNTIL OK ;
  113.              Assign(Outfile,File2);
  114.                     REPEAT
  115.                     {$I-} Rewrite(outfile) {$I+};
  116.                     OK := IOResult = 0;
  117.                     IF NOT OK
  118.                     THEN
  119.                         BEGIN
  120.                         gotoxy(10,15);
  121.                         Writeln(^g,'Output file name invalid! Please reenter: ');
  122.                         END;
  123.                    UNTIL OK;
  124.             END;
  125.             UNTIL OK;
  126. END;
  127.  
  128. {-------------------------------------------------------}
  129.  
  130. BEGIN
  131. Initialize;
  132. lines := 0;
  133. short_lines := 0;
  134. clrscr;
  135. linereader;
  136. Close(Infile);
  137. Close(Outfile);
  138. gotoxy(40,10);
  139. clreol;
  140. gotoxy(40,12);
  141. clreol;
  142. gotoxy(10,20);
  143. Sound(2000);
  144. Delay(200);
  145. NoSound;
  146. Sound(1000);
  147. Delay(100);
  148. NoSound;
  149. Writeln('File Processed successfully');
  150. END.
  151.